Celestin Apprentice 2/Apprentice-Release2.iso/Source Code/Peter Lewis/Talk 1.0.6/My Libraries/MyNotifier.unit

Text File | 1992-04-20 | 5.2 KB | 193 lines | [TEXT/PJMM]

unit MyNotifier;

{ This program was written by Peter N Lewis, Mar 1992 in THINK Pascal 4.0.1 }

{ Derived from <[e-mail]> Joe Holt's StartupError code as posted }
{ to comp.sys.mac.programmer in May 1991 }

{ Notification Manager messages }

{ History: }
{   jhh 18 jun 90 -- response to news posting }
{   pnl 29 may 91 -- Converted to pascal to be used in an application }

interface

    const
        mark_app = 1;
        mark_none = 0;

    procedure InitNotify;
    procedure FinishNotify;
    procedure NotifyH (mark: integer; sound: handle; sicn: handle; str: stringPtr; display_time: longInt);
    procedure Notify (mark, sound: boolean; sicn_id, sicn_index, str_id, str_index: integer; display_time: longInt);
{ mark - mark the current application }
{ sound - play sysbeep }
{ sicn_id, sicn_index - SICN id to rotate with the apple & index (<1 -> 1)   OR 0&0 for no sicn }
{ str_id, str_index - STR# id & index    OR    STR id & 0    OR    0 & 0 }
    procedure NotifyIdle (foreground: boolean);
{ Call this in the event loop with the boolean true if you are in the foreground to remove apple mark and flash }
    procedure UnNotify;
{ Call this to get rid of the notification }

    var
        notify_finished, notify_outstanding: boolean;
        time_to_unnotify: longInt;

implementation

    uses
        Notification;

    const
        sicn_size = 32;
        T_NMInstall = $A05E;
        T_Unimplemented = $A89F;

    type
        NMRecPtrPtr = ^NMRecPtr;
        booleanPtr = ^boolean;

    var
        current_note: NMRecPtr;

{ handles must be non-purgeable, but may be unlocked }

{$S Init}
    procedure InitNotify;
    begin
        current_note := nil;
        notify_finished := false;
        notify_outstanding := false;
        time_to_unnotify := maxLongInt;
    end;

{$S}
    procedure MyResponse (note: NMRecPtr);
    begin
        booleanPtr(note^.nmRefCon)^ := true;
    end;

{$S Util}
    procedure UnNotify;
        var
            oe: OSErr;
    begin
        if current_note <> nil then begin
            oe := NMRemove(current_note);
            with current_note^ do begin
                if nmStr <> nil then
                    DisposPtr(pointer(nmStr));
                if nmIcon <> nil then
                    DisposHandle(nmIcon);
            end;
            DisposPtr(pointer(current_note));
            current_note := nil;
        end;
        notify_finished := false;
        notify_outstanding := false;
        time_to_unnotify := maxLongInt;
    end;

{$S}
    procedure NotifyIdle (foreground: boolean);
    begin
        if notify_finished and foreground or (TickCount > time_to_unnotify) then
            UnNotify;
    end;

{$S Term}
    procedure FinishNotify;
    begin
        if current_note <> nil then
            UnNotify;
    end;

{$S Util}
    procedure NotifyH (mark: integer; sound: handle; sicn: handle; str: stringPtr; display_time: longInt);
        var
            errorText: str255;
            sh: stringHandle;
            sicnH: handle;
            error: boolean;
            oe: OSErr;
    begin
        UnNotify;            { Clear outstanding notify }
        if NGetTrapAddress(T_NMInstall, OSTrap) = NGetTrapAddress(T_Unimplemented, ToolTrap) then begin
            SysBeep(1);   { Best we can do I guess.  Could put up the dialog box maybe?...}
        end
        else begin
            current_note := NMRecPtr(NewPtr(sizeof(NMRec)));
            if current_note = nil then begin
                SysBeep(1);   { Can't do much else if there isnt even room for this! }
            end
            else begin
                with current_note^ do begin
                    qType := nmType;
                    error := false;
                    booleanPtr(nmRefCon) := @notify_finished;
                    nmMark := mark;
                    nmStr := str;
                    nmIcon := sicn;
                    nmSound := sound;
                    nmResp := @MyResponse;
                end;
                oe := NMInstall(current_note);
                if oe <> noErr then begin
                    current_note := nil;
                    SysBeep(1);
                end
                else begin
                    notify_outstanding := true;
                    if display_time > 0 then
                        time_to_unnotify := TickCount + display_time;
                end;
            end;
        end;
    end;

{$S Util}
    procedure Notify (mark, sound: boolean; sicn_id, sicn_index, str_id, str_index: integer; display_time: longInt);
        var
            errorText: str255;
            sh: stringHandle;
            sicnH: handle;
            error: boolean;
            oe: OSErr;
            nmMark: integer;
            nmStr: stringPtr;
            nmIcon: handle;
            nmSound: handle;
    begin
        error := false;
        if mark then
            nmMark := 1
        else
            nmMark := 0;
        nmStr := nil;
        if str_id <> 0 then begin
            if str_index > 0 then
                GetIndString(errorText, str_id, str_index)
            else begin
                errorText := '';
                sh := GetString(str_id);
                if sh <> nil then begin
                    if sh^ <> nil then
                        errorText := sh^^;
                    ReleaseResource(handle(sh));
                end;
            end;
            if errorText = '' then
                error := true
            else begin
                nmStr := stringPtr(NewPtr(length(errorText) + 1));
                if nmStr = nil then
                    error := true
                else
                    nmStr^ := errorText;
            end;
        end;
        nmIcon := nil;
        if sicn_id <> 0 then begin
            if sicn_index < 1 then
                sicn_ind